home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / internet / irc_i_dodatki / eggdrop / eggdrop11.lha / scripts / ques3.tcl < prev    next >
Encoding:
Text File  |  1997-01-15  |  7.0 KB  |  179 lines
  1. #
  2. # quesedilla, by robey
  3. # v1 -- 20aug95
  4. # v2 -- 2oct95   [improved it]
  5. # v3 -- 17mar96  [fixed it up for 1.0 multi-channel]
  6. # 
  7. # this will create an html file every so often (the default is once every
  8. # 5 minutes).  the html file will have a table showing the people currently
  9. # on the channel, their user@hosts, who's an op, and who's idle.  it
  10. # uses a table which some browsers (and pseudo-browsers like lynx) can't
  11. # see, but it can optionally make a second page which will support these
  12. # archaic browsers.  browsers supporting push-pull will receive the updated
  13. # page automatically periodically.
  14. #
  15. # if you have a "url" field defined for a user, their nickname in the
  16. # table will be a link pointing there.  otherwise it checks the info
  17. # line and comment field to see if they start with "http://" -- if so,
  18. # that link will be used.  as a last resort, it will make a "mailto:"
  19. # link if an email address is recorded for the user.
  20. #
  21. # feel free to modify and play with this.  the original was written in
  22. # 15 minutes, then at various times i fixed bugs and added features.
  23. # softlord helped me make the design look a little nicer. :)  if you make
  24. # any nifty improvements, please let me know.
  25. #                                       robey@netcom.com
  26.  
  27.  
  28. ## this line makes sure other scripts won't interfere
  29. catch {unset webfile}
  30.  
  31. ## for each channel you want a webfile for, do this:
  32. set webfile(#turtle) "/home/robey/public_html/turtle.html"
  33. set webfile(#gloom) "/home/robey/public_html/gloom.html"
  34.  
  35. ## define these for channels you want alternate (lynx-friendly) web pages
  36. ## for:  (the 'lynxfilerf' needs to be relative to your html directory)
  37. set lynxfile(#turtle) "/home/robey/public_html/turtle-lynx.html"
  38. set lynxfilerf(#turtle) "turtle-lynx.html"
  39.  
  40. ## how often should these html files get updated?
  41. ## (1 means once every minute, 5 means once every 5 minutes, etc)
  42. set web_update 5
  43.  
  44. ## this will help people figure out what timezone you're in :)
  45. set webtz [clock format 0 -format %Z]
  46. ## if that line breaks, you're using an older Tcl library and will have to
  47. ## set it manually like so:
  48. #set webtz "PST"
  49.  
  50.  
  51. proc do_ques {} {
  52.   global webfile lynxfile web_update botnick webtz lynxfilerf
  53.   foreach chan [array names webfile] {
  54.     if {[lsearch -exact [string tolower [channels]] [string tolower $chan]] == -1} {continue}
  55.     set fd [open $webfile($chan) w]
  56.     if {[info exists lynxfile($chan)]} {
  57.       set fdl [open $lynxfile($chan) w]
  58.     } else {
  59.       set fdl [open "/dev/null" w]
  60.     }
  61.     puts $fd "<meta http-equiv=\"Refresh\" content=[expr $web_update *60]>"
  62.     if {![onchan $botnick $chan]} {
  63.       puts $fd "<html><head><title>People on $chan right now</title></head>"
  64.       puts $fd "<body><h1>Oops!</h1><p>"
  65.       puts $fd "I'm not on $chan right now for some reason.<br>"
  66.       puts $fd "IRC isn't a very stable place these days... Please try again"
  67.       puts $fd "later!<p></body></html>"
  68.       puts $fdl "<html><head><title>People on $chan right now</title></head>"
  69.       puts $fdl "<body><h1>Oops!</h1><p>"
  70.       puts $fdl "I'm not on $chan right now for some reason.<br>"
  71.       puts $fdl "IRC isn't a very stable place these days... Please try again"
  72.       puts $fdl "later!<p></body></html>"
  73.       close $fd
  74.       close $fdl
  75.     } {
  76.       puts $fd "<html><head><title>People on $chan right now</title></head>"
  77.       puts $fd "<body><center><h1>$chan</h1>"
  78.       puts $fdl "<html><head><title>People on $chan right now</title></head>"
  79.       puts $fdl "<body><h1>$chan</h1>"
  80.       if {[info exists lynxfile($chan)]} {
  81.         puts $fd "<p>If this page looks screwy on your browser, try"
  82.         puts $fd "<a href=\"$lynxfilerf($chan)\">this page</a>.<p>"
  83.       }
  84.       puts $fd "<table border=1 cellpadding=4>"
  85.       puts $fd "<caption>People on $chan as of [date] [time] $webtz</caption>"
  86.       puts $fd "<th align=left>Nickname<th align=left>Status"
  87.       puts $fd "<th align=left>User@Host"
  88.       puts $fdl "<em>People on $chan as of [date] [time] $webtz</em><pre>"
  89.       puts $fdl "Nickname  Status           User@Host"
  90.       foreach i [chanlist $chan] {
  91.         puts $fd "<tr>"
  92.         if {[isop $i $chan]} { set chop "op"} { set chop "" }
  93.         if {[getchanidle $i $chan] > 10} {
  94.           if {$chop == ""} { set chop "idle" } { set chop "${chop}, idle" }
  95.         }
  96.         set handle [finduser $i![getchanhost $i $chan]]
  97.         if {[onchansplit $i $chan]} {
  98.           if {$chop == ""} { 
  99.             set chop "<strong>(split)</strong>"
  100.           } {
  101.             set chop "${chop} <strong>(split)</strong>"
  102.           }
  103.         }
  104.         set url [user-get $handle url]
  105.         set info [getinfo $handle]
  106.         set comment [getcomment $handle]
  107.         if {"" == $chop} { set chop "-" }
  108.         set link ""
  109.         if {"" != $url} {
  110.           set link "<a href=\"$url\">"
  111.         }
  112.         if {("" == $link) && 
  113.             ([string compare [string range $comment 0 6] "http://"] == 0)} {
  114.           set link "<a href=\"[lindex [split $comment] 0]\">"
  115.         }
  116.         if {("" == $link) &&
  117.             ([string compare [string range $info 0 6] "http://"] == 0)} {
  118.           set link "<a href=\"[lindex [split $info] 0]\">"
  119.         }
  120.         if {"" == $link} {
  121.           set email [getemail $handle]
  122.           if {("" != $email) && ([string first @ $email] > 0)} {
  123.             set link "<a href=\"mailto:$email\">"
  124.           }
  125.         }
  126.         if {"" != $link} { set elink "</a>" } { set elink "" }
  127.         puts $fd "<td align=left>${link}${i}${elink}</td>"
  128.         puts $fd "<td align=left>${chop}</td>"
  129.         set chost [getchanhost $i $chan]
  130.         if {[string compare [string tolower $i] [string tolower $botnick]] == 0} {
  131.           set chost "<em>This is me, the channel bot.</em>"
  132.           set info ""
  133.         } {
  134.           if {[matchattr $handle b]} {
  135.             set chost "<em>This is another channel bot.</em>"
  136.             set info ""
  137.           }
  138.         }
  139.         puts $fd "<td align=left>${chost}</td>"
  140.         puts $fdl "${link}[format %-9s $i]${elink} [format %-16s $chop] $chost"
  141.         if {"" != $info} {
  142.           puts $fd "<tr><td></td><td colspan=2><strong>Info:</strong> $info</td>"
  143.           puts $fdl "   <strong>Info:</strong> $info"
  144.         }
  145.       }
  146.       puts $fd "</table></center>"
  147.       puts $fdl "</pre>"
  148.       puts $fd "<p><hr><address>Created by quesedilla v3 via"
  149.       puts $fd "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
  150.       puts $fd "eggdrop</a></address>"
  151.       puts $fdl "<p><hr><address>Created by quesedilla v3 via"
  152.       puts $fdl "<a href=\"http://www.calweb.com/~xerxes/eggdrop/\">"
  153.       puts $fdl "eggdrop</a></address>"
  154.       puts $fd "<address>This page is automatically refreshed.</address>"
  155.       puts $fd "</body></html>"
  156.       puts $fdl "</body></html>"
  157.       close $fd
  158.       close $fdl
  159.     }
  160.   }
  161.   timer $web_update do_ques
  162. }
  163.  
  164. if {![info exists ques_going]} {
  165.   timer $web_update do_ques
  166.   set ques_going 1
  167. }
  168. set xxchans ""
  169. foreach i [array names webfile] {
  170.   set xxchans "$xxchans $i"
  171.   if {![info exists lynxfile($i)]} {
  172.     set xxchans "$xxchans (no lynx)"
  173.   }
  174.   set xxchans "${xxchans},"
  175. }
  176. set xxchans [string trimright $xxchans ","]
  177. putlog "Quesedilla v3:$xxchans"
  178. unset xxchans
  179.